(library (user-input-output)
  (export read-char
          read-line
          write-string
          ask-nothing
          ask-user
          ask-user-for-text
          ask-user-for-character
          ask-user-for-number
          ask-user-for-integer-number
          ask-user-for-boolean
          ask-user-for-yes-no-decision
          ask-user-for-decision
          ask-user-for-decision-with-continuations
          ask-user-for-decision-return-value
          confirm-info-message)
  (import
    (except (rnrs base) let-values map error)
    (only (guile)
          ;; lambda forms
          lambda* λ
          ;; conditionals
          when
          ;; input output
          simple-format
          current-output-port
          call-with-output-string
          current-input-port
          display
          newline
          ;; strings
          string-trim
          string-join
          string-append
          string-delete
          string-trim-both
          char-set:whitespace
          ;; other
          error
          pk)
    (message-builder)
    (ice-9 textual-ports)
    (ice-9 optargs)
    (ice-9 exceptions)
    ;; srfi-1 for list procedures
    (srfi srfi-1)))


(define read-char
  (lambda* (#:key (input-port (current-input-port)))
    (get-char input-port)))


(define read-line
  (lambda* (#:key (input-port (current-input-port)))
    (get-line input-port)))


(define trim-whitespace-chars
  (λ (string)
    "Trim whitespace characters from the left and right end
of the given string."
    (string-trim-both string char-set:whitespace)))


(define output-and-get-input
  (lambda* (message
            #:key
            (inputter read-line)
            (output-port (current-output-port))
            (input-port (current-input-port)))
    "Display a given MESSAGE to the given OUTPUT-PORT and
get input from the given INPUT-PORT using the given
INPUTTER."
    (display message output-port)
    (inputter #:input-port input-port)))


(define get-input-until
  (lambda* (inputter
            pred
            #:key
            (invalid-input-message "invalid input")
            (input-port (current-input-port))
            (output-port (current-output-port)))
    "Get input until the predicate is satisfied."
    (let try-again ([input (inputter)])
      (cond
       [(pred input) input]
       [else
        (display invalid-input-message output-port)
        (try-again (inputter))]))))


(define ask-nothing
  (λ ()
    (read-char)))


(define ask-user
  (lambda* (question
            pred
            #:key
            (prompt-text "input")
            (input-cleanup-proc trim-whitespace-chars)
            (possible-answers #f)
            (answer->value #f)
            (question-to-prompt-separator "")
            (q-a-separator ": ")
            (choices-opener "(")
            (choices-separator "/")
            (choices-closer ")")
            (question-to-choices-separator " ")
            (invalid-input-message "Invalid input.\n")
            (input-port (current-input-port))
            (output-port (current-output-port)))
    "Ask a question, clean the input of its answer using the given
INPUT-CLEANUP-PROC, and check the cleaned answer using the given predicate
PRED. Either provide POSSIBLE-ANSWERS or leave it at its default #f."

    (define ask-question
      (λ ()
        (define message
          (string-join (list question
                             (build-prompt-string prompt-text
                                                  #:choices possible-answers
                                                  #:choices-opener choices-opener
                                                  #:choices-separator choices-separator
                                                  #:choices-closer choices-closer
                                                  #:input-separator q-a-separator))
                       question-to-prompt-separator))
        (output-and-get-input message #:output-port output-port)))

    (let ([cleaned-input
           (get-input-until ask-question
                            (λ (raw-input)
                              (let ([cleaned-input (input-cleanup-proc raw-input)])
                                (and (pred cleaned-input)
                                     (cond
                                      [possible-answers (member cleaned-input possible-answers)]
                                      [else cleaned-input]))))
                            #:invalid-input-message invalid-input-message
                            #:input-port input-port
                            #:output-port output-port)])
      (if answer->value
          (answer->value cleaned-input)
          cleaned-input))))


(define ask-user-for-decision-with-continuations
  (lambda* (question
            choices
            choice-texts
            continuations
            #:key
            (input-port (current-input-port))
            (output-port (current-output-port)))
    (let* ([message
            (string-append question "\n" (choices->message choices choice-texts))]
           [chosen
            (ask-user message
                      (λ (input) (member input choices))
                      #:possible-answers choices
                      #:question-to-choices-separator "")])
      (let next ([rest-choices choices] [rest-continuations continuations])
        (cond
         [(null? rest-choices)
          (raise-exception
           (make-exception
            (make-non-continuable-error)
            (make-exception-with-message "user choice matches none of the available choices")
            (make-exception-with-irritants (list chosen choices))
            (make-exception-with-origin 'ask-user-for-decision-with-continuations)))]
         [(string=? chosen (first rest-choices))
          ((first rest-continuations))]
         [else
          (next (cdr rest-choices)
                (cdr rest-continuations))])))))


(define ask-user-for-decision-return-value
  (lambda* (question
            choices
            choice-texts
            return-values
            #:key
            (prompt-text "input")
            (input-port (current-input-port))
            (output-port (current-output-port)))
    (let* ([message (string-append question "\n" (choices->message choices choice-texts))]
           [chosen
            (ask-user message
                      (λ (input) (member input choices))
                      #:prompt-text prompt-text
                      #:possible-answers choices
                      #:question-to-choices-separator "")])
      (let next ([rest-choices choices] [rest-return-values return-values])
        (cond
         [(null? rest-choices)
          (error "one of the choices should have been equal" chosen choices)]
         [(string=? chosen (first rest-choices))
          (first rest-return-values)]
         [else
          (next (cdr rest-choices)
                (cdr rest-return-values))])))))


(define ask-user-for-text
  (lambda* (question
            #:key
            (prompt-text "input")
            (input-port (current-input-port))
            (output-port (current-output-port)))
    (ask-user question
              (λ (input) #t)
              #:prompt-text prompt-text
              #:input-port input-port
              #:output-port output-port)))


(define ask-user-for-character
  (lambda* (question
            char-pred
            #:key
            (invalid-input-message "Invalid input. Enter a character.\n")
            (input-port (current-input-port))
            (output-port (current-output-port)))
    (ask-user question
              (λ (input)
                (and (= (string-length input) 1)
                     (char-pred (car (string->list input)))))
              #:invalid-input-message invalid-input-message)))


(define ask-user-for-number
  (lambda* (question
            number-pred
            #:key
            (prompt-text "number")
            (input-port (current-input-port))
            (output-port (current-output-port)))
    "Ask the user for a input, which must be a number and
secondly must satisfy the given number predicate."
    (string->number
     (ask-user question
               (lambda (raw-input)
                 (let ([input (string->number raw-input)])
                   (and input (number-pred input))))
               #:prompt-text prompt-text))))


(define ask-user-for-integer-number
  (lambda* (question
            number-pred
            #:key
            (prompt-text "integer")
            (input-port (current-input-port))
            (output-port (current-output-port)))
    "Ask the user for an integer number, for which the given
NUMBER-PRED returns #t."
    (ask-user-for-number question
                         (λ (num)
                           (and (number-pred num)
                                (integer? num)))
                         #:prompt-text prompt-text)))


(define ask-user-for-boolean
  (lambda* (question
            #:key
            (prompt-text "boolean")
            (input-port (current-input-port))
            (output-port (current-output-port)))
    "Ask the user for a input, which must be a number and
secondly must satisfy the given number predicate."
    (ask-user-for-decision-return-value question
                                        '("t" "f")
                                        '("true" "false")
                                        '(#t #f)
                                        #:prompt-text prompt-text
                                        #:input-port input-port
                                        #:output-port output-port)))


(define ask-user-for-yes-no-decision
  (lambda* (question
            positive-answers
            negative-answers
            #:key
            (input-port (current-input-port))
            (output-port (current-output-port)))
    "Ask the user for a yes/no decision, where yes and no
can have an arbitrary number of aliases each, given as
POSITIVE-ANSWERS and NEGATIVE-ANSWERS."
    (let* ([input-predicate
            (λ (input)
              (member input
                      (lset-union string=? positive-answers negative-answers)))]
           [user-input
            (ask-user question
                      input-predicate
                      #:possible-answers
                      (reverse (lset-union string=?
                                           positive-answers
                                           negative-answers)))])
      (member user-input positive-answers))))


(define ask-user-for-decision
  (lambda* (question
            choices
            #:key
            (input-port (current-input-port))
            (output-port (current-output-port)))
    (ask-user question
              (λ (input)
                (member input choices))
              #:possible-answers choices)))


(define confirm-info-message
  (lambda* (msg
            #:key
            (input-port (current-input-port))
            (output-port (current-output-port)))
    (simple-format (current-output-port) "INFO: ~a" msg)
    (read-line)))
